home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d19
/
15rpch33.arc
/
EXAMPLE.BAS
< prev
next >
Wrap
BASIC Source File
|
1988-09-28
|
15KB
|
329 lines
' $INCLUDE: 'DOORPCH.USR'
100 PROGNAME$ = "Example" ' These
PROGB$ = "EXAMPLE" ' four
R.ELEASE$ = "2.1" ' MUST
NODE% = 1 ' be populated
' $INCLUDE: 'DOORPCH.BEG' ' CALLs INITIALIZATION code in DORPCH33.EXE
CLOSE #1 ' If you had other information within
' DOORPCHn.CFG, you would continue reading
' the file here then CLOSE #1.
' Detects Alias (read from ENDMON) and installs if Alias name has data in it.
IF ALIAS.FIRST$ <> "" THEN
IF ALIAS.LAST$ <> "" THEN
FIRST$ = ALIAS.FIRST$
LAST$ = ALIAS.LAST$
END IF
END IF
XPOS% = 5: YPOS% = 1
CALL OUT.PUT
FGC% = 5: TBSN% = 23: BLINK% = 1: LN$ = "DOORPCH 3.3": CALL OUT.NCR
FGC% = 2: LN$ = " demo brought to you by": CALL OUT.PUT
FGC% = 2: CENTER% = 1: LN$ = "SysOp: " + SYSFIRST$ + " " + SYSLAST$ + " of " + SYSNAME$
LN$ = LN$ + ", a " + BBSSYS$ + " BBS": CALL OUT.PUT: CALL OUT.PUT
FGC% = 2: CENTER% = 1: LN$ = "You are about to have a visual demonstration": CALL OUT.PUT
FGC% = 2: CENTER% = 1: LN$ = "of the capabilities of DOORPCH 3.3 (DOOR PATCH)": CALL COLOR.CHK: CALL OUT.PUT
FGC% = 2: CENTER% = 1: LN$ = "DOORPCH is simply the BEST door code available": CALL OUT.PUT
FGC% = 1: BLINK% = 1: CENTER% = 1: LN$ = "PERIOD!": CALL OUT.PUT
FGC% = 2: CENTER% = 1: LN$ = "Many more capabilities exist than displayed here": CALL OUT.PUT
FGC% = 2: CENTER% = 1: LN$ = "Give it a whirl. If you find a function not": CALL OUT.PUT
FGC% = 2: CENTER% = 1: LN$ = "provided by DOORPCH, simply contact one of our": CALL OUT.PUT
FGC% = 2: CENTER% = 1: LN$ = "BBS's and give us your requirements . . . .": CALL OUT.PUT
CALL OUT.PUT
CALL ENTER
120 DO
CALL CLR.SCRN
FGC% = 5: LN$ = "Example DOOR Menu": CENTER% = 1: CALL OUT.PUT
FGC% = 7: LN$ = "=================": CENTER% = 1: CALL OUT.PUT
XPOS% = 5: YPOS% = 1: FGC% = 2: LN$ = "Select one of the following examples:": CALL OUT.PUT
CALL OUT.PUT
FGC% = 6: LN$ = "[1] - Music Output": CALL COLOR.CHK: CALL OUT.NCR
IF NETWORK% = 1 AND LOCALX = 1 THEN LN$ = ", unavailable in NETWORK LOCAL mode"
CALL OUT.PUT
FGC% = 6: LN$ = "[2] - Screen Positioning": CALL COLOR.CHK: CALL OUT.PUT
FGC% = 6: LN$ = "[3] - High Scores": CALL COLOR.CHK: CALL OUT.PUT
FGC% = 6: LN$ = "[4] - Centering output": CALL COLOR.CHK: CALL OUT.PUT
FGC% = 6: LN$ = "[5] - SUBS: COLOR.CHK, GET.KEY, GET.KEYECHO": CALL COLOR.CHK: CALL OUT.PUT
FGC% = 6: LN$ = " IN.PUT, OUT.PUT and ENTER": CALL OUT.PUT
FGC% = 6: LN$ = "[6] - Cursor positioning with SUB GET.KEY": CALL COLOR.CHK: CALL OUT.PUT
FGC% = 6: LN$ = "[7] - Read Graphics files / menus from disk !": CALL COLOR.CHK: CALL OUT.PUT
FGC% = 6: LN$ = "[8] - Make those fancy prompts !": CALL COLOR.CHK: CALL OUT.PUT
FGC% = 6: LN$ = "[9] - Exit and Return to System or Monitor": CALL COLOR.CHK
CALL OUT.PUT: CALL OUT.PUT
FGC% = 2: LN$ = "(" + MID$(STR$(DMIN%),2) + " min. left) Enter Selection, " + FIRST$ + " ? ": CALL COLOR.CHK: CALL IN.PUT
IF ARG$ = "" THEN GOTO 120
SEL = VAL(ARG$)
SELECT CASE SEL
CASE 9
CALL CLR.SCRN
FGC% = 1: CENTER% = 1: LN$ = "Thanks for testing " + PROGNAME$: CALL OUT.PUT
FGC% = 2: CENTER% = 1: LN$ = "Now try your hand at writing DOOR's": CALL OUT.PUT
FGC% = 3: CENTER% = 1: LN$ = "Its really very easy as you can see": CALL OUT.PUT
CALL OUT.PUT:CALL OUT.PUT
FGC% = 6: LN$ = "DOORPCH 3.3 Authors": CENTER% =1: CALL OUT.PUT: CALL OUT.PUT
FGC% = 3: LN$ = "Clint Labarthe, Black Hole BBS, (407) 260-6397": CENTER% =1: CALL OUT.PUT
FGC% = 3: LN$ = "Terry Shockley, Death Star BBS, (407) 660-6300": CENTER% =1: CALL OUT.PUT
FGC% = 3: LN$ = "Ben Perron, Computer Playroom BBS, (203) 584-1798": CENTER% =1: CALL OUT.PUT: CALL OUT.PUT
FGC% = 1: LN$ = "Assembler programming by Harold Thomson": CENTER% =1: CALL OUT.PUT: CALL OUT.PUT
FGC% = 7: LN$ = "with contributing support from": CENTER% =1: CALL OUT.PUT: CALL OUT.PUT
FGC% = 6: LN$ = "Raymond Clements, Pegasus BBS, (502) 684-9855": CENTER% =1: CALL OUT.PUT
FGC% = 7: LN$ = "and": CENTER% =1: CALL OUT.PUT
FGC% = 6: LN$ = "Pat Carone, Enterprise-A BBS, (412) 465-8601": CENTER% =1: CALL OUT.PUT
CALL OUT.PUT
EXIT DO
CASE 1 TO 8
ON SEL GOSUB 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800
CASE ELSE
END SELECT
LOOP UNTIL SEL = 9
' END OF MAIN LOOP
CALL EXITG ' Never come back. DOOR terminates in DOORPCH code
' Music example
1100
CALL CLR.SCRN
FGC% = 5: LN$ = "Music Output Example": CENTER% = 1: CALL OUT.PUT
FGC% = 7: LN$ = "====================": CENTER% = 1: CALL OUT.PUT
CALL OUT.PUT
CALL OUT.PUT
FGC% = 2: LN$ = "Can your system handle music [y/N] ? ": CALL COLOR.CHK
CALL IN.PUT
IF MID$(ARG$, 1, 1) <> "Y" THEN RETURN
CALL OUT.PUT
LN$ = "ALOYTTE"
CALL OUT.PUT
MUSIC$ = "L4E.L8F#L4G#G#L8F#EF#G#L4EO1BO2E.L8F#L4G#G#L8F#EF#G#L2EL8EF#G#ABBL4BL8BO3C#O2BAG#F#L4EL8BBL4BO1L8BBL4BO2L8BBL4BO1L8BBL4BO2L1BL4E.L8F#L4G#G#L8F#EF#G#L4EO1BO2E.L8F#L4G#G# L4F#EF#G#L2E"
CALL MUSICG
CALL OUT.PUT
CALL OUT.PUT
CALL MORE
CALL OUT.PUT
IF MID$(ARG$, 1, 1) <> "E" THEN
LN$ = "TOM DOOLEY"
CALL OUT.PUT
MUSIC$ = "L4DDEGBL2BL4BDDEGL1AL4DDEGAL2A.L8AAAAL4GEL2G.P4L8DL4DL8DL4EGL2BBL8DL4DL8EL4GL1AL8DL4DL8DL4EGL2AAL8AL4AL8BL4GEL2G"
END IF
CALL MUSICG
CALL OUT.PUT
CALL ENTER
RETURN
' Screen Positioning Example
1200 CALL CLR.SCRN
FGC% = 5: LN$ = "ANSI Screen Positioning Example": CENTER% = 1: CALL OUT.PUT
FGC% = 7: LN$ = "===============================": CENTER% = 1: CALL OUT.PUT
1210 ' The right side of the box
FOR X = 16 TO 4 STEP -1
XPOS% = X
YPOS% = 3
LN$ = CHR$(186)
CALL OUT.NCR
NEXT X
' The corner of the box left top
XPOS% = 3
YPOS% = 3
LN$ = CHR$(201)
CALL OUT.NCR
' The top of the box
FOR X = 4 TO 77
XPOS% = 3
YPOS% = X
LN$ = CHR$(205)
CALL OUT.NCR
NEXT X
' top right corner
XPOS% = 3
YPOS% = 78
LN$ = CHR$(187)
CALL OUT.NCR
' right side
FOR X = 4 TO 16
XPOS% = X
YPOS% = 78
LN$ = CHR$(186)
CALL OUT.NCR
NEXT X
' The bottom right side corner
XPOS% = 17
YPOS% = 78
LN$ = CHR$(188)
CALL OUT.NCR
' The bottom of the box
FOR X = 77 TO 4 STEP -1
XPOS% = 17
YPOS% = X
LN$ = CHR$(205)
CALL OUT.NCR
NEXT X
' left side corner bottom
YPOS% = 3
XPOS% = 17
LN$ = CHR$(200)
CALL OUT.NCR
XPOS% = 18
YPOS% = 1
CALL OUT.PUT
IF SEL = 2 THEN
XPOS% = 9: YPOS% = 20: FGC% = 5 ' Set coordinates and magenta color
LN$ = "Almost anything is possible with ": CALL OUT.NCR
FGC% = 7
LN$ = "DOORPCH !": CALL OUT.PUT
XPOS% = 19
YPOS% = 1
CALL OUT.NCR
CALL ENTER
END IF
RETURN
' High Scores Example
1300
CALL CLR.SCRN
FGC% = 7: LN$ = "High Scores Example": CENTER% = 1: CALL OUT.PUT
LN$ = "===================": CENTER% = 1: CALL OUT.PUT
CALL OUT.PUT
FGC% = 5: BLINK% = 1: LN$ = "Selecting a score randomly . . .": CALL OUT.NCR
HSCR# = INT(RND * 1000 + 1)
LN$ = " the score selected is " + STR$(HSCR#): CALL OUT.PUT
CALL OUT.PUT
CALL HIGH.SCORE
RETURN
1400 'Centering example
CALL CLR.SCRN: XPOS% = 10: YPOS% = 1 ' Row 10, Column 01
LN$ = "This text is centered": CENTER% = 1: CALL OUT.PUT: CALL OUT.PUT
CALL ENTER
RETURN
1500 'Example of how SUB COLOR.CHK operates
CALL CLR.SCRN
1501 FGC% = 6: LN$ = "This example requires pressing RETURN": CALL OUT.PUT: CALL OUT.PUT
FGC% = 3: LN$ = "It also": CALL OUT.NCR
FGC% = 1: LN$ = " ECHO's ": CALL OUT.NCR
FGC% = 3: LN$ = "the character": CALL OUT.PUT:CALL OUT.PUT
FGC% = 2: LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ": CALL COLOR.CHK: CALL IN.PUT
IF ARG$ = "P" OR ARG$ = "Q" OR ARG$ = "C" THEN ELSE 1501
CALL OUT.PUT: CALL OUT.PUT
FGC% = 5: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT:CALL OUT.PUT: CALL ENTER
1502 CALL CLR.SCRN: FGC% = 6: LN$ = "You can also get a character WITHOUT a RETURN": CALL OUT.PUT: CALL OUT.PUT
FGC% = 3: LN$ = "It also": CALL OUT.NCR
FGC% = 1: LN$ = " ECHO's ": CALL OUT.NCR
FGC% = 3: LN$ = "the character": CALL OUT.PUT:CALL OUT.PUT
FGC% = 2: LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ":CALL COLOR.CHK: CALL GET.KEYECHO
IF ARG$ = "P" OR ARG$ = "Q" OR ARG$ = "C" THEN ELSE 1502
CALL OUT.PUT:CALL OUT.PUT
FGC% = 5: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT: CALL OUT.PUT:CALL ENTER
1503 CALL CLR.SCRN: FGC% = 6: LN$ = "This example does NOT require pressing RETURN": CALL OUT.PUT:CALL OUT.PUT
FGC% = 3: LN$ = "It also": CALL OUT.NCR
FGC% = 1: LN$ = " DOES NOT ECHO ": CALL OUT.NCR
FGC% = 3: LN$ = "the character": CALL OUT.PUT:CALL OUT.PUT
FGC% = 2: LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ":CALL COLOR.CHK: CALL GET.KEY
IF ARG$ = "P" OR ARG$ = "Q" OR ARG$ = "C" THEN ELSE 1503
CALL OUT.PUT: CALL OUT.PUT
FGC% = 5: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT:CALL OUT.PUT: CALL ENTER
1504 CALL CLR.SCRN: FGC% = 6: LN$ = "This example requires pressing RETURN": CALL OUT.PUT: CALL OUT.PUT
FGC% = 3: LN$ = "It also": CALL OUT.NCR
FGC% = 1: LN$ = " ECHO's ": CALL OUT.NCR
FGC% = 3: LN$ = "the character": CALL OUT.PUT:CALL OUT.PUT
FGC% = 7: LN$ = "Oh so you expect LOWER case ?": CALL OUT.PUT:CALL OUT.PUT
FGC% = 2: RETURNCASE% = -1:LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ": CALL COLOR.CHK: CALL IN.PUT
IF ARG$ = "p" OR ARG$ = "q" OR ARG$ = "c" THEN ELSE 1504
CALL OUT.PUT
CALL OUT.PUT
FGC% = 5: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT:CALL OUT.PUT: CALL ENTER
CALL CLR.SCRN: XPOS% = 9: YPOS% = 10: FGC% = 6: LN$ = "So you want more than one ": CALL OUT.NCR
FGC% = 3: LN$ = "color": CALL OUT.NCR
FGC% = 6: LN$ = " on same line, and a BELL too!": BELL% = 1: CALL OUT.PUT:CALL OUT.PUT
CALL OUT.PUT:CALL ENTER ' Gives the caller an ENTER prompt
RETURN
1600 CALL CLR.SCRN
FGC% = 5: LN$ = "ANSI Cursor Positioning Example": CENTER% = 1: CALL OUT.PUT
FGC% = 7: LN$ = "===============================": CENTER% = 1: CALL OUT.PUT
GOSUB 1210
BOUNDLEFT = 4: BOUNDRIGHT = 77
BOUNDBOTTOM = 16: BOUNDTOP = 4
LN$ = "Press NUM-LOCK then press"
XPOS% = 18: YPOS% = 1: CENTER% = 1: CALL OUT.PUT
LN$ = "(8) for UP, (6) for RIGHT, (2) for DOWN and (4) for LEFT": CENTER% = 1: CALL COLOR.CHK
CALL OUT.PUT
LN$ = "(5) to EXIT, <ENTER> to place an `X'": CENTER% = 1: CALL COLOR.CHK
CALL OUT.PUT
XPOS% = 21: YPOS% = 1: CALL OUT.PUT
CALL ENTER
XPOS% = 8: TEMPX% = XPOS%: YPOS% = 39: TEMPY% = YPOS%: CALL OUT.NCR
1610 DO
CALL GET.KEY
SELECT CASE LEFT$(ARG$,1)
CASE "8"
TEMPX% = TEMPX% - 1
GOSUB RANGE
CASE "6"
TEMPY% = TEMPY% + 1
GOSUB RANGE
CASE "2"
TEMPX% = TEMPX% + 1
GOSUB RANGE
CASE "4"
TEMPY% = TEMPY% - 1
GOSUB RANGE
CASE "5" 'Just a place to end this routine for testing
EXIT DO
CASE ELSE
IF LEFT$(ARG$,1) = CHR$(13) THEN
XPOS% = TEMPX%: YPOS% = TEMPY%
LN$ = "X": CALL OUT.NCR
XPOS% = TEMPX%: YPOS% = TEMPY%
LN$ = "": CALL OUT.NCR
END IF
END SELECT
LOOP
RETURN
RANGE:
IF TEMPY% > BOUNDRIGHT THEN TEMPY% = 4
IF TEMPY% < BOUNDLEFT THEN TEMPY% = 77
IF TEMPX% > BOUNDBOTTOM THEN TEMPX% = 4
IF TEMPX% < BOUNDTOP THEN TEMPX% = 16
XPOS% = TEMPX%: YPOS% = TEMPY%: LN$ = "": CALL OUT.NCR
RETURN
1700 CALL CLR.SCRN
LN$ = "You can even read graphics screens or menus from disk !"
CENTER% = 1: CALL OUT.PUT
CALL READ.TXT("EXAMPLE.SCR") 'Graphics mode will read <filename>G.SCR
CALL ENTER
RETURN
1800 CALL CLR.SCRN
CENTER% = 1
LN$ = "You can now make those fancy prompts without getting a headache. . ."
CALL OUT.PUT
XPOS% = 5: YPOS% = 1
CENTER% = 1
FGC% = 2
LN$ = "[T]rains, [P]lanes and [A]utomobiles"
CALL COLOR.CHK
CALL OUT.PUT: CALL OUT.PUT
CENTER% = 1
FGC% = 7
LN$ = "or ....": CALL OUT.PUT
XPOS% = 9: YPOS% = 1: CENTER% = 1
FGC% = 6
LN$ = "Select a category: <a,b,c,d> or [q]uit or <Q>uit or [1,2,3,Q,g,x]"
CALL COLOR.CHK
CALL OUT.PUT: CALL OUT.PUT
CENTER% = 1
FGC% = 7
LN$ = "or ....": CALL OUT.PUT
FGC% = 3
XPOS% = 13: YPOS% = 1: CENTER% = 1
LN$ = "<CAPITAL LETTERS get one color, 123456 get another, lower case another>"
CALL COLOR.CHK
CALL OUT.PUT: CALL OUT.PUT: CALL OUT.PUT
XPOS% =18: YPOS% = 29
FGC% = 5
LN$ = "DOORPCH makes it "
CALL OUT.NCR
BLINK% = 1
FGC% = 5
LN$ = "easy!"
CALL OUT.PUT: CALL OUT.PUT
XPOS% =23: YPOS% = 1
CALL ENTER
RETURN
' $INCLUDE: 'DOORPCH.END'